home *** CD-ROM | disk | FTP | other *** search
/ Ultimedia 2 / Ultimedia 2.iso / tools / soundtools / speechtoy / source.lha / SpeechToy.f < prev   
Encoding:
FORTH Source  |  1994-04-14  |  65.8 KB  |  2,280 lines
  1. 0 .if
  2.  
  3. SpeechToy?  9 years later?????   Yep.
  4.  
  5. I thought it would be a kick for it to re-emerge as JForth source
  6. and executable!   (Ok, maybe I need to get out more.)
  7.  
  8. I've included the original C source code, in case you might
  9. like to compare them.  JForth is really very easy to port to
  10. from C.
  11.  
  12. And thanks, Dave M Lucas.  I suppose that if you weren't before,
  13. you are now, an official pioneer!
  14.  
  15. In this JForth version, I added the 2.0 colors, shaded gadgets and 
  16. the LOOP Button.  Other than that, it's a true & faithful port.
  17.  
  18. Anyway, hope everyone gets some enjoyment out of this, at least
  19. as much as I did converting it to JForth!  I especially
  20. laughed at the very first paragraph below!
  21.  
  22. - Mike Haas
  23. mikeh@starnine.com
  24.  
  25. 3867 La Colina Rd.
  26. El Sobrante, CA. 94803
  27.  
  28. So here it is, Speechtoy, all new and yet the same, but guarenteed
  29. Forthified!
  30.  
  31. AND... still public domain!   Take it away, Dave...
  32.  
  33. /* !!! To those who haven't figured it out yet:
  34.  * !!! set stack to 15000 before compiling.      <- not in JForth!!! :-)
  35.  * !!! This is a generally good thing to do if
  36.  * !!! the compiler blows up on a large source.            <-!!! ??? !!!
  37.  * !!! if your program suddenly KILLS the compiler,
  38.  * !!! increase stack by 5K and try again. jeeze you guys. <-!!! ??? !!!
  39.  */
  40. /* This program was written to show the use of gadgets in a
  41.  * window. Thus one menu, one auto requester, but lots of
  42.  * gadget types.
  43.  * For the sake of example, two mutual exclude gadgets
  44.  * (female/male) are shown that perform a function that might
  45.  * be better implemented as a toggle image, in a manner similar
  46.  * to that shown in the inflection Mode gadget.
  47.  * Again for the sake of example, the proportional gadgets
  48.  * are generated dynamicly (that is, copied from a template and
  49.  * filled in)n whereas most gadgets are declared staticly in
  50.  * the struct declaration, which saves the initialization code
  51.  * space.
  52.  * Lastly, for the sake of example, this program is extremely
  53.  * verbose in the way of comments. Hope you don't mind.
  54.  */
  55. /* Written by David M Lucas. */
  56. /* If you find somthing you don't like, fix it! Have fun! */
  57. /* Send complaints to /dev/null. really. */
  58. /* Thanks Amiga. */
  59. .then
  60.  
  61. getmodule includes
  62.  
  63. 0 .IF
  64. #include "exec/types.h"
  65. #include "exec/exec.h"
  66. #include "intuition/intuition.h"
  67. #include "intuition/intuitionbase.h"
  68. #include "graphics/regions.h"
  69. #include "graphics/copper.h"
  70. #include "graphics/gels.h"
  71. #include "graphics/gfxbase.h"
  72. #include "devices/keymap.h"
  73. #include "hardware/blit.h"
  74. #include "devices/narrator.h"
  75. #include "libraries/translator.h"
  76. .THEN
  77.  
  78. include? goto.error ju:goto_error  \ this came in VERY handy in one place
  79.                                    \ nice to have for porting from C
  80.  
  81. anew task-SpeechToy.f
  82.  
  83. \ All needed Amiga support words, so we don't have to compile
  84. \ the ju: files for just these...
  85.  
  86. asm NewList()   ( &list -- )
  87.     move.l  tos,a0
  88.     adda.l  org,a0
  89.     \
  90.     move.l  a0,[lh_tailpred](a0)
  91.     addq.l  #4,a0    ;get address of lh_tail
  92.     clr.l   (a0)    ;clear lh_tail
  93.     move.l  a0,-(a0)    ;address of lh_tail to lh_head
  94.     \
  95.     move.l  (dsp)+,tos
  96.     forth{  BOTH  }
  97. end-code
  98.  
  99. : OpenWindow() ( newwindow -- wdw/0 )
  100.   call>abs intuition_lib OpenWindow if>rel  ;
  101.  
  102. : CloseWindow() ( window -- )
  103.   callvoid>abs intuition_lib CloseWindow  ;
  104.  
  105. : AllocSignal() ( signal -- sigbit )
  106.   call exec_lib AllocSignal  ;
  107.  
  108. : FreeSignal() ( sigbit -- )
  109.   callvoid exec_lib FreeSignal  ;
  110.  
  111. : FindTask() ( 0name -- task )
  112.   call exec_lib FindTask if>rel  ;
  113.  
  114. : SetAPen() ( rport pen -- )
  115.   callvoid>abs graphics_lib SetAPen  ;
  116.  
  117. : RectFill() ( rport l t w h -- )
  118.   callvoid>abs graphics_lib RectFill  ;
  119.  
  120. : Move() ( rport x y -- )
  121.   callvoid>abs graphics_lib Move  ;
  122.  
  123. : Draw() ( rport x y -- )
  124.   callvoid>abs graphics_lib Draw  ;
  125.  
  126. : RefreshGadgets() ( gadget window screen? -- )
  127.   callvoid>abs intuition_lib RefreshGadgets  ;
  128.  
  129. : SetMenuStrip()   ( ControlWindow &MyMenu -- )
  130.   callvoid>abs intuition_lib SetMenuStrip  ;
  131.  
  132. : Wait()   ( mask -- signals )
  133.   call exec_lib Wait  ;
  134.  
  135. : GetMsg() ( port -- msg )
  136.   call>abs exec_lib GetMsg if>rel  ;
  137.  
  138. : ReplyMsg()  ( msg -- )
  139.   callvoid>abs exec_lib ReplyMsg  ;
  140.  
  141. : DisplayBeep()  ( scr -- )
  142.   callvoid>abs intuition_lib DisplayBeep  ;
  143.  
  144. : RemoveGadget()  ( win gad -- pos )
  145.   call>abs intuition_lib RemoveGadget  ;
  146.  
  147. : OnGadget()  ( gad win scr -- )
  148.   callvoid>abs intuition_lib OnGadget  ;
  149.  
  150. : OffGadget()  ( gad win scr -- )
  151.   callvoid>abs intuition_lib OffGadget  ;
  152.  
  153. : AddGadget()  ( win gad pos -- )
  154.   callvoid>abs intuition_lib AddGadget  ;
  155.  
  156. : WaitBOVP()  ( viewport -- )
  157.   callvoid>abs graphics_lib WaitBOVP  ;
  158.  
  159. : SendIO()  ( ioreq -- )
  160.   callvoid>abs exec_lib SendIO  ;
  161.   
  162. : AbortIO()  ( ioreq -- )
  163.   callvoid>abs exec_lib AbortIO  ;
  164.   
  165. : AutoRequest()  ( win body yText nText pFlag nFlag wid hght -- response )
  166.   call>abs intuition_lib AutoRequest  ;
  167.   
  168. : Translate()  ( inbuf inlen outbuf outlen -- err )
  169.   call>abs translator_lib Translate  ;
  170.  
  171. : AllocMem()  ( size type -- mem )
  172.   call exec_lib AllocMem if>rel  ;
  173.  
  174. : FreeMem()  ( mem size -- )
  175.   callvoid>abs exec_lib FreeMem  ;
  176.  
  177. : MENUNUM() ( menucode -- menu# )
  178.     $ 1F AND  ;
  179.  
  180. : ITEMNUM() ( menucode -- item# )
  181.     -5 ashift  $ 3F AND  ;
  182.  
  183. \ : 4*  cells inline ;
  184.  
  185. : >>  negate ashift ;
  186.  
  187.  
  188. \ seems to work, so...
  189. \ : STDEBUG ;
  190.  
  191.  
  192. 321 CONSTANT CONTWINDW  \  /* Overall Control Window Width/Height */
  193. 123 CONSTANT CONTWINDH  \ 
  194. 32 CONSTANT FACEWINDW  \   /* Overall Face Window Width / Height */
  195. 44 CONSTANT FACEWINDH  \   /* this includes borders, incedently */
  196.  
  197. \ /* Pen numbers to draw gadget borders/images/text with */
  198. 3 CONSTANT REDP  \           /* color in register 3 once was red */
  199. 2 CONSTANT WHTP  \           /* color in register 2 was black */
  200. 1 CONSTANT BLKP  \           /* color in register 1 was white */
  201. 0 CONSTANT GRYP  \           /* color in register 0 was blue */
  202.  
  203. \ /* the length of the English and phonetic buffers */
  204. 512 CONSTANT ESTRINGSIZE  \ 
  205. 768 CONSTANT PSTRINGSIZE  \  /* phonemes are longer than english */
  206.  
  207. 4 CONSTANT NUMPROPS  \       /* number of proportional gadgets */
  208.  
  209. \ /* Ranges of proportional data */
  210.    MAXFREQ   MINFREQ  - 1+  CONSTANT RNGFREQ
  211.    MAXRATE   MINRATE  - 1+  CONSTANT RNGRATE
  212.    MAXPITCH  MINPITCH - 1+  CONSTANT RNGPITCH
  213.    MAXVOL    MINVOL   - 1+  CONSTANT RNGVOL
  214.  
  215. defer Initialize
  216.  
  217. : Initialize1 ;
  218.  
  219.  
  220. TextAttr TestFont
  221.    TOPAZ_EIGHTY TestFont s! ta_YSize
  222.    0 TestFont s! ta_Style
  223.    0 TestFont s! ta_Flags
  224.  
  225. : Initialize2  ( -- )  Initialize1
  226.   0" topaz.font" TestFont s! ta_Name
  227. ;
  228.  
  229.  
  230. \ /* Which audio channels to use */
  231. 4 CARRAY audio_chan
  232.      3 0 audio_chan c!
  233.      5 1 audio_chan c!
  234.     10 2 audio_chan c!
  235.     12 3 audio_chan c!
  236.  
  237. \ /* Pointer to translator library vectors */
  238. \ value TranslatorBase   TranslatorBase off
  239.  
  240. MsgPort talk_port     \ Message port for the say's I/O  */
  241. MsgPort read_port     \ Message port for the say's I/O  */
  242. mouth_rb mouth_io     \ IO Request block, mouth flavor */
  243.  
  244. \ /* IO Request block, narrator flavor */
  245. narrator_rb voice_io
  246. \ /* indicative of the Open return */
  247. -1 value NarratorOpenError   -1 -> NarratorOpenError        \ /* not yet opened */
  248. \ /* indicative of a Translations success */
  249. 0 value TranslatorError
  250.  
  251. 0 value NarratorVersion
  252.  
  253. : Initialize3 Initialize2
  254.    -1 -> NarratorOpenError        \ /* not yet opened */
  255.     0 -> TranslatorError
  256. ;
  257.  
  258. 0 value ii
  259.  
  260. \ /* These are used to draw the eyes and mouth size relative */
  261. 0 value MouthWMult
  262. 0 value EyesLeft
  263. 0 value MouthHMult
  264. 0 value EyesTop
  265. 0 value EyesBottom
  266. 0 value YMouthCenter  \ /* Pixels from top edge */
  267. 0 value XMouthCenter  \ /* Pixels from left edge */
  268. 0 value yaw
  269. 0 value LipWidth
  270. 0 value LipHeight
  271.  
  272. 0 .if
  273. /* String Gadgets *********************************************
  274.  * First the string gadgets.
  275.  * 1) because the Phonetic string is refreshed programaticly
  276.  * (that is, deleted and added again) quite often, and doing
  277.  * this requires the use of RefreshGadgets(), and this causes
  278.  * gadgets that are closer to the beginning of the list than
  279.  * the gadget given to RefreshGadgets() to flicker.
  280.  * 2) because they don't flicker when OTHER gadgets
  281.  * (ie female/male, coming up) are deleted and added.
  282.  */
  283. /* These'll be used to put a nice double line border around
  284.  * each of the two string gadgets.
  285.  */
  286. /* y,x pairs drawn as a connected line. Be sure to have an even
  287.  * number of arguments (ie complete pairs).
  288.  */
  289. .then
  290.  
  291. create StrVectorsLT
  292.  
  293.    0 w,  14 w,    0 w,   0 w,   297 w,  0 w,   296 w,   1 w,
  294.    1 w,   1 w,    1 w,  13 w,
  295.    
  296.    
  297. create StrVectorsBR
  298.  
  299.    1 w,  14 w,   297 w, 14 w,    297 w, 1 w,   296 w,   2 w,
  300.  296 w,  13 w,     2 w, 13 w,
  301.    
  302. Border StrBorderLT
  303.  
  304.   -4 StrBorderLT s! bd_LeftEdge
  305.   -3 StrBorderLT s! bd_TopEdge
  306. BLKP StrBorderLT s! bd_FrontPen
  307. GRYP StrBorderLT s! bd_BackPen
  308. JAM1 StrBorderLT s! bd_DrawMode
  309.    6 StrBorderLT s! bd_Count
  310.    0 StrBorderLT s! bd_NextBorder
  311.  
  312. Border StrBorder
  313.  
  314.   -4 StrBorder s! bd_LeftEdge
  315.   -3 StrBorder s! bd_TopEdge
  316. WHTP StrBorder s! bd_FrontPen
  317. GRYP StrBorder s! bd_BackPen
  318. JAM1 StrBorder s! bd_DrawMode
  319.    6 StrBorder s! bd_Count
  320.    0 StrBorder s! bd_NextBorder
  321.  
  322. : Initialize4  ( -- )  Initialize3
  323.   StrVectorsLT  StrBorderLT s! bd_XY
  324.   StrVectorsBR  StrBorder   s! bd_XY
  325.   0             StrBorderLT s! bd_NextBorder
  326.   StrBorderLT   StrBorder   s! bd_NextBorder
  327. ;
  328.  
  329.  
  330. \ /* The same undo buffer is used for both string gadgets,
  331. \  * this is sized to largest so that largest fits.
  332. \  */
  333.  
  334. create UndoBuffer   PSTRINGSIZE allot  here even-up dp !
  335. UndoBuffer  here UndoBuffer -  cell- erase
  336.  
  337. \ /* English String Gadget is where the user types in English */
  338. \ /* default text */
  339. create EnglBuffer   ESTRINGSIZE allot  here even-up dp !
  340. EnglBuffer  here EnglBuffer -  cell- erase
  341.  
  342. 0" This is amiga speaking." 0count 1+  EnglBuffer  swap move
  343.  
  344. StringInfo EnglInfo
  345.  
  346.               0 EnglInfo s! si_BufferPos
  347.     ESTRINGSIZE EnglInfo s! si_MaxChars
  348.               0 EnglInfo s! si_DispPos
  349.               0 EnglInfo s! si_UndoPos
  350.              24 EnglInfo s! si_NumChars
  351.               0 EnglInfo s! si_DispCount
  352.               0 EnglInfo s! si_CLeft
  353.               0 EnglInfo s! si_CTop
  354.               0 EnglInfo s! si_Extension
  355.               0 EnglInfo s! si_LongInt
  356.               0 EnglInfo s! si_AltKeyMap
  357.  
  358. : Initialize5  ( -- )  Initialize4
  359.     EnglBuffer EnglInfo s! si_Buffer
  360.     UndoBuffer EnglInfo s! si_UndoBuffer
  361. ;
  362.  
  363.  
  364. IntuiText EnglText
  365.  
  366.     BLKP EnglText s! it_FrontPen
  367.     GRYP EnglText s! it_BackPen
  368.     JAM1 EnglText s! it_DrawMode
  369.        0 EnglText s! it_LeftEdge
  370.      -13 EnglText s! it_TopEdge
  371.        0 EnglText s! it_NextText
  372.  
  373. : Initialize6  ( -- )  Initialize5
  374.     TestFont     EnglText s! it_ITextFont
  375.     0" English:" EnglText s! it_IText
  376. ;
  377.  
  378.  
  379.  
  380. Gadget EnglStrGadget
  381.  
  382.                0 EnglStrGadget s! gg_NextGadget
  383.               11 EnglStrGadget s! gg_LeftEdge
  384.               63 EnglStrGadget s! gg_TopEdge
  385.              290 EnglStrGadget s! gg_Width
  386.               10 EnglStrGadget s! gg_Height
  387.        GADGHCOMP EnglStrGadget s! gg_Flags
  388.        RELVERIFY EnglStrGadget s! gg_Activation
  389.        STRGADGET EnglStrGadget s! gg_GadgetType
  390.                0 EnglStrGadget s! gg_SelectRender
  391.                0 EnglStrGadget s! gg_MutualExclude
  392.                0 EnglStrGadget s! gg_GadgetID
  393.                0 EnglStrGadget s! gg_UserData
  394.  
  395. : Initialize7  ( -- )  Initialize6
  396.     StrBorder EnglStrGadget s! gg_GadgetRender
  397.     EnglText  EnglStrGadget s! gg_GadgetText
  398.     EnglInfo  EnglStrGadget s! gg_SpecialInfo
  399. ;
  400.  
  401.  
  402.  
  403.  
  404. \ /* Phonetic string gadget is where the program puts the
  405. \  * translated string, necessating a call to RefreshGadgets(),
  406. \  * and is where the user can type in Phonemes.
  407. \  */
  408.  
  409. create PhonBuffer    PSTRINGSIZE allot  here even-up dp !
  410.   0" DHIHS IHZ AHMIY3GAH SPIY4KIHNX." 0count 1+  PhonBuffer swap move
  411.  
  412.  
  413.  
  414. StringInfo PhonInfo
  415.  
  416.               0 PhonInfo s! si_BufferPos
  417.     PSTRINGSIZE PhonInfo s! si_MaxChars
  418.               0 PhonInfo s! si_DispPos
  419.               0 PhonInfo s! si_UndoPos
  420.              32 PhonInfo s! si_NumChars
  421.               0 PhonInfo s! si_DispCount
  422.               0 PhonInfo s! si_CLeft
  423.               0 PhonInfo s! si_CTop
  424.               0 PhonInfo s! si_Extension
  425.               0 PhonInfo s! si_LongInt
  426.               0 PhonInfo s! si_AltKeyMap
  427.  
  428. : Initialize8  ( -- )  Initialize7
  429.     PhonBuffer PhonInfo s! si_Buffer
  430.     UndoBuffer PhonInfo s! si_UndoBuffer
  431. ;
  432.  
  433.  
  434. IntuiText PhonText
  435.  
  436.     BLKP PhonText s! it_FrontPen
  437.     GRYP PhonText s! it_BackPen
  438.     JAM1 PhonText s! it_DrawMode
  439.        0 PhonText s! it_LeftEdge
  440.      -13 PhonText s! it_TopEdge
  441.        0 PhonText s! it_NextText
  442.  
  443. : Initialize9  ( -- )  Initialize8
  444.     TestFont       PhonText s! it_ITextFont
  445.     0" Phonetics:" PhonText s! it_IText
  446. ;
  447.  
  448.  
  449. Gadget PhonStrGadget
  450.  
  451.                0 PhonStrGadget s! gg_NextGadget
  452.               11 PhonStrGadget s! gg_LeftEdge
  453.               94 PhonStrGadget s! gg_TopEdge
  454.              290 PhonStrGadget s! gg_Width
  455.               10 PhonStrGadget s! gg_Height
  456.        GADGHCOMP PhonStrGadget s! gg_Flags
  457.        RELVERIFY PhonStrGadget s! gg_Activation
  458.        STRGADGET PhonStrGadget s! gg_GadgetType
  459.                0 PhonStrGadget s! gg_SelectRender
  460.                0 PhonStrGadget s! gg_MutualExclude
  461.                0 PhonStrGadget s! gg_GadgetID
  462.                0 PhonStrGadget s! gg_UserData
  463.  
  464. : Initialize10  ( -- )  Initialize9
  465.     EnglStrGadget PhonStrGadget s! gg_Nextgadget
  466.     StrBorder     PhonStrGadget s! gg_GadgetRender
  467.     PhonText      PhonStrGadget s! gg_GadgetText
  468.     PhonInfo      PhonStrGadget s! gg_SpecialInfo
  469. ;
  470.  
  471. \ /* Now come the Boolean Gadgets.
  472. \  * The female/male pair shows the simplest implementation I
  473. \  * could think of to show how you can do mutual-exclude type
  474. \  * things yourself. They are two toggle gadgets that use
  475. \  * highlight image. The program starts with one selected, and
  476. \  * then if either of them are hit, both toggle. Gadgets must
  477. \  * be deleted and added whenever you want to change structure
  478. \  * member values that intuition expects to be coming from the
  479. \  * user, not a program (like the SELECTED bit in flags). Note
  480. \  * that certain structure values CAN be changed programaticly
  481. \  * without all this broohaha. Haha. Consult the intuition
  482. \  * manual.
  483. \  */
  484. \ /* Female Toggle (Highlight Image)
  485. \    (Quasi mutual exclude with Male Toggle) */
  486.  
  487. Image FemaleImage
  488.  
  489.      0 FemaleImage s! ig_LeftEdge
  490.      0 FemaleImage s! ig_TopEdge
  491.     20 FemaleImage s! ig_Width
  492.     10 FemaleImage s! ig_Height
  493.      2 FemaleImage s! ig_Depth
  494.      0 FemaleImage s! ig_ImageData
  495.      3 FemaleImage s! ig_PlanePick
  496.      0 FemaleImage s! ig_PlaneOnOff
  497.      0 FemaleImage s! ig_NextImage
  498.  
  499. Gadget FemaleGadget
  500.  
  501.     134 FemaleGadget s! gg_LeftEdge
  502.      34 FemaleGadget s! gg_TopEdge
  503.      20 FemaleGadget s! gg_Width
  504.      10 FemaleGadget s! gg_Height
  505.     GADGIMAGE GADGHCOMP |  FemaleGadget s! gg_Flags
  506.     RELVERIFY GADGIMMEDIATE | TOGGLESELECT |  FemaleGadget s! gg_Activation
  507.     BOOLGADGET FemaleGadget s! gg_GadgetType
  508.       0 FemaleGadget s! gg_SelectRender
  509.       0 FemaleGadget s! gg_GadgetText
  510.       0 FemaleGadget s! gg_MutualExclude
  511.       0 FemaleGadget s! gg_SpecialInfo
  512.       0 FemaleGadget s! gg_GadgetID
  513.       0 FemaleGadget s! gg_UserData
  514.  
  515. : Initialize11  ( -- )  Initialize10
  516.     [ GADGIMAGE GADGHCOMP | ] literal  FemaleGadget s! gg_Flags
  517.     PhonStrGadget FemaleGadget s! gg_NextGadget
  518.     FemaleImage   FemaleGadget s! gg_GadgetRender
  519. ;
  520.  
  521.  
  522.  
  523. \ /* Male Toggle (Highlight Image)
  524. \    (Quasi mutual Exclude with above) */
  525.  
  526. Image MaleImage
  527.  
  528.      0 MaleImage s! ig_LeftEdge
  529.      0 MaleImage s! ig_TopEdge
  530.     20 MaleImage s! ig_Width
  531.     10 MaleImage s! ig_Height
  532.      2 MaleImage s! ig_Depth
  533.      0 MaleImage s! ig_ImageData
  534.      3 MaleImage s! ig_PlanePick
  535.      0 MaleImage s! ig_PlaneOnOff
  536.      0 MaleImage s! ig_NextImage
  537.  
  538. Gadget MaleGadget
  539.  
  540.     154 MaleGadget s! gg_LeftEdge
  541.      34 MaleGadget s! gg_TopEdge
  542.      20 MaleGadget s! gg_Width
  543.      10 MaleGadget s! gg_Height
  544.     GADGIMAGE GADGHCOMP | SELECTED |  MaleGadget s! gg_Flags
  545.     RELVERIFY GADGIMMEDIATE | TOGGLESELECT | ACTIVATE |  MaleGadget s! gg_Activation
  546.     BOOLGADGET MaleGadget s! gg_GadgetType
  547.       0 MaleGadget s! gg_SelectRender
  548.       0 MaleGadget s! gg_GadgetText
  549.       0 MaleGadget s! gg_MutualExclude
  550.       0 MaleGadget s! gg_SpecialInfo
  551.       0 MaleGadget s! gg_GadgetID
  552.       0 MaleGadget s! gg_UserData
  553.  
  554. : Initialize12  ( -- )  Initialize11
  555.     [ GADGIMAGE GADGHCOMP | SELECTED | ] literal   MaleGadget s! gg_Flags
  556.     FemaleGadget  MaleGadget s! gg_NextGadget
  557.     MaleImage     MaleGadget s! gg_GadgetRender
  558. ;
  559.  
  560.  
  561.  
  562.  
  563.  
  564.  
  565. \ /* This boolean toggle gadget has an
  566. \  * alternate image that indicates
  567. \  * selection. The image stays flipped
  568. \  * until it gets another hit. (it toggles)
  569. \  */
  570. \ /* Inflection Mode Toggle (AltImage) *************************/
  571.  
  572.  
  573. Image HumanImage
  574.  
  575.      0 HumanImage s! ig_LeftEdge
  576.      0 HumanImage s! ig_TopEdge
  577.     40 HumanImage s! ig_Width
  578.     20 HumanImage s! ig_Height
  579.      2 HumanImage s! ig_Depth
  580.      0 HumanImage s! ig_ImageData
  581.      3 HumanImage s! ig_PlanePick
  582.      0 HumanImage s! ig_PlaneOnOff
  583.      0 HumanImage s! ig_NextImage
  584.  
  585. Image RobotImage
  586.  
  587.      0 RobotImage s! ig_LeftEdge
  588.      0 RobotImage s! ig_TopEdge
  589.     40 RobotImage s! ig_Width
  590.     20 RobotImage s! ig_Height
  591.      2 RobotImage s! ig_Depth
  592.      0 RobotImage s! ig_ImageData
  593.      3 RobotImage s! ig_PlanePick
  594.      0 RobotImage s! ig_PlaneOnOff
  595.      0 RobotImage s! ig_NextImage
  596.  
  597.  
  598. Gadget ModeGadget
  599.  
  600.     134 ModeGadget s! gg_LeftEdge
  601.       2 ModeGadget s! gg_TopEdge
  602.      40 ModeGadget s! gg_Width
  603.      20 ModeGadget s! gg_Height
  604.     GADGIMAGE GADGHIMAGE |  ModeGadget s! gg_Flags
  605.     RELVERIFY GADGIMMEDIATE | TOGGLESELECT |  ModeGadget s! gg_Activation
  606.     BOOLGADGET ModeGadget s! gg_GadgetType
  607.       0 ModeGadget s! gg_SelectRender
  608.       0 ModeGadget s! gg_GadgetText
  609.       0 ModeGadget s! gg_MutualExclude
  610.       0 ModeGadget s! gg_SpecialInfo
  611.       0 ModeGadget s! gg_GadgetID
  612.       0 ModeGadget s! gg_UserData
  613.  
  614. : Initialize13  ( -- )  Initialize12
  615.     [ GADGIMAGE GADGHIMAGE | ] literal   ModeGadget s! gg_Flags
  616.     MaleGadget    ModeGadget s! gg_NextGadget
  617.     HumanImage    ModeGadget s! gg_GadgetRender
  618.     RobotImage    ModeGadget s! gg_SelectRender
  619. ;
  620.  
  621.  
  622.  
  623. \ /* Face Toggle (image and text) ******************************/
  624.  
  625. IntuiText FaceIText
  626.  
  627.     BLKP FaceIText s! it_FrontPen
  628.     GRYP FaceIText s! it_BackPen
  629.     JAM2 FaceIText s! it_DrawMode
  630.        4 FaceIText s! it_LeftEdge
  631.        1 FaceIText s! it_TopEdge
  632.        0 FaceIText s! it_NextText
  633.  
  634. : Initialize14  ( -- )  Initialize13
  635.     TestFont FaceIText s! it_ITextFont
  636.     0" Face" FaceIText s! it_IText
  637. ;
  638.  
  639. Image FaceImage
  640.  
  641.      0 FaceImage s! ig_LeftEdge
  642.      0 FaceImage s! ig_TopEdge
  643.     40 FaceImage s! ig_Width
  644.     10 FaceImage s! ig_Height
  645.      2 FaceImage s! ig_Depth
  646.      0 FaceImage s! ig_ImageData
  647.      3 FaceImage s! ig_PlanePick
  648.      0 FaceImage s! ig_PlaneOnOff
  649.      0 FaceImage s! ig_NextImage
  650.  
  651.  
  652. Gadget FaceGadget
  653.  
  654.              134 FaceGadget s! gg_LeftEdge
  655.               23 FaceGadget s! gg_TopEdge
  656.               40 FaceGadget s! gg_Width
  657.               10 FaceGadget s! gg_Height
  658.        GADGHCOMP GADGIMAGE |  FaceGadget s! gg_Flags
  659.        RELVERIFY GADGIMMEDIATE | TOGGLESELECT | FaceGadget s! gg_Activation
  660.        BOOLGADGET FaceGadget s! gg_GadgetType
  661.                0 FaceGadget s! gg_SelectRender
  662.                0 FaceGadget s! gg_MutualExclude
  663.                0 FaceGadget s! gg_GadgetID
  664.                0 FaceGadget s! gg_UserData
  665.  
  666. : Initialize14a  ( -- )  Initialize14
  667.     ModeGadget    FaceGadget s! gg_Nextgadget
  668.     FaceImage     FaceGadget s! gg_GadgetRender
  669.     FaceIText     FaceGadget s! gg_GadgetText
  670. ;
  671.  
  672.  
  673. IntuiText StopIText
  674.  
  675.     BLKP StopIText s! it_FrontPen
  676.     GRYP StopIText s! it_BackPen
  677.     JAM2 StopIText s! it_DrawMode
  678.        4 StopIText s! it_LeftEdge
  679.        1 StopIText s! it_TopEdge
  680.        0 StopIText s! it_NextText
  681.  
  682. : Initialize15  ( -- )  Initialize14a
  683.     TestFont StopIText s! it_ITextFont
  684.     0" Stop" StopIText s! it_IText
  685. ;
  686.  
  687. Image StopImage
  688.  
  689.      0 StopImage s! ig_LeftEdge
  690.      0 StopImage s! ig_TopEdge
  691.     40 StopImage s! ig_Width
  692.     10 StopImage s! ig_Height
  693.      2 StopImage s! ig_Depth
  694.      0 StopImage s! ig_ImageData
  695.      3 StopImage s! ig_PlanePick
  696.      0 StopImage s! ig_PlaneOnOff
  697.      0 StopImage s! ig_NextImage
  698.  
  699. Gadget StopGadget
  700.  
  701.     134 StopGadget s! gg_LeftEdge
  702.      45 StopGadget s! gg_TopEdge
  703.      40 StopGadget s! gg_Width
  704.      10 StopGadget s! gg_Height
  705.     GADGIMAGE GADGHCOMP |  StopGadget s! gg_Flags
  706.     RELVERIFY GADGIMMEDIATE |   StopGadget s! gg_Activation
  707.     BOOLGADGET StopGadget s! gg_GadgetType
  708.       0 StopGadget s! gg_SelectRender
  709.       0 StopGadget s! gg_MutualExclude
  710.       0 StopGadget s! gg_SpecialInfo
  711.       0 StopGadget s! gg_GadgetID
  712.       0 StopGadget s! gg_UserData
  713.  
  714. : Initialize16  ( -- )  Initialize15
  715.     FaceGadget  StopGadget s! gg_NextGadget
  716.     StopImage   StopGadget s! gg_GadgetRender
  717.     StopIText   StopGadget s! gg_GadgetText
  718. ;
  719.  
  720.  
  721.  
  722.  
  723.  
  724.  
  725. \ /* This is a hit (as opposed to toggle)
  726. \    gadget that starts the translation.*/
  727. \ /* Translate Hit (Highlight image) ***************************/
  728. create TransVectorsLT[]
  729.    0 w, 13 w,    0 w,  0 w,   79 w, 0 w,   78 w, 1 w,
  730.    1 w,  1 w,    1 w, 12 w,
  731.    
  732. create TransVectorsBR[]
  733.    1 w, 13 w,   79 w, 13 w,   79 w, 1 w,   78 w, 2 w,
  734.   78 w, 12 w,    2 w, 12 w,
  735.    
  736.  
  737. Border TransBorderLT
  738.  
  739.   -4 TransBorderLT s! bd_LeftEdge
  740.   -3 TransBorderLT s! bd_TopEdge
  741. WHTP TransBorderLT s! bd_FrontPen
  742. GRYP TransBorderLT s! bd_BackPen
  743. JAM1 TransBorderLT s! bd_DrawMode
  744.    6 TransBorderLT s! bd_Count
  745.    0 TransBorderLT s! bd_NextBorder
  746.  
  747. Border TransBorder
  748.  
  749.   -4 TransBorder s! bd_LeftEdge
  750.   -3 TransBorder s! bd_TopEdge
  751. BLKP TransBorder s! bd_FrontPen
  752. GRYP TransBorder s! bd_BackPen
  753. JAM1 TransBorder s! bd_DrawMode
  754.    6 TransBorder s! bd_Count
  755.    0 TransBorder s! bd_NextBorder
  756.  
  757. : Initialize17  ( -- )  Initialize16
  758.   TransVectorsLT[]  TransBorderLT s! bd_XY
  759.   TransVectorsBR[]  TransBorder   s! bd_XY
  760.   0               TransBorderLT s! bd_NextBorder
  761.   TransBorderLT   TransBorder   s! bd_NextBorder
  762. ;
  763.  
  764. IntuiText TranslateIText
  765.  
  766.     BLKP TranslateIText s! it_FrontPen
  767.     GRYP TranslateIText s! it_BackPen
  768.     JAM2 TranslateIText s! it_DrawMode
  769.        0 TranslateIText s! it_LeftEdge
  770.        0 TranslateIText s! it_TopEdge
  771.        0 TranslateIText s! it_NextText
  772.  
  773. : Initialize18  ( -- )  Initialize17
  774.     TestFont TranslateIText s! it_ITextFont
  775.     0" Translate" TranslateIText s! it_IText
  776. ;
  777.  
  778.  
  779. Gadget TranslateGadget
  780.  
  781.     229 TranslateGadget s! gg_LeftEdge
  782.      48 TranslateGadget s! gg_TopEdge
  783.      71 TranslateGadget s! gg_Width
  784.       8 TranslateGadget s! gg_Height
  785.     GADGHCOMP  TranslateGadget s! gg_Flags
  786.     RELVERIFY GADGIMMEDIATE |   TranslateGadget s! gg_Activation
  787.     BOOLGADGET TranslateGadget s! gg_GadgetType
  788.       0 TranslateGadget s! gg_SelectRender
  789.       0 TranslateGadget s! gg_MutualExclude
  790.       0 TranslateGadget s! gg_SpecialInfo
  791.       0 TranslateGadget s! gg_GadgetID
  792.       0 TranslateGadget s! gg_UserData
  793.  
  794. : Initialize19  ( -- )  Initialize18
  795.     StopGadget     TranslateGadget s! gg_NextGadget
  796.     TransBorder    TranslateGadget s! gg_GadgetRender
  797.     TranslateIText TranslateGadget s! gg_GadgetText
  798. ;
  799.  
  800.  
  801. \ /* This is a hit (as opposed to toggle) Starts the narration */
  802. \ /* Speak Hit (Highlight Image) *******************************/
  803. create SpeakVectorsLT[]
  804.    0 w, 13 w,    0 w,  0 w,   47 w, 0 w,   46 w, 1 w,
  805.    1 w,  1 w,    1 w, 12 w,
  806.    
  807. create SpeakVectorsBR[]
  808.    1 w, 13 w,   47 w, 13 w,   47 w, 1 w,   46 w, 2 w,
  809.   46 w, 12 w,    2 w, 12 w,
  810.    
  811.  
  812. Border SpeakBorderLT
  813.  
  814.   -4 SpeakBorderLT s! bd_LeftEdge
  815.   -3 SpeakBorderLT s! bd_TopEdge
  816. WHTP SpeakBorderLT s! bd_FrontPen
  817. GRYP SpeakBorderLT s! bd_BackPen
  818. JAM1 SpeakBorderLT s! bd_DrawMode
  819.    6 SpeakBorderLT s! bd_Count
  820.    0 SpeakBorderLT s! bd_NextBorder
  821.  
  822. Border SpeakBorder
  823.  
  824.   -4 SpeakBorder s! bd_LeftEdge
  825.   -3 SpeakBorder s! bd_TopEdge
  826. BLKP SpeakBorder s! bd_FrontPen
  827. GRYP SpeakBorder s! bd_BackPen
  828. JAM1 SpeakBorder s! bd_DrawMode
  829.    6 SpeakBorder s! bd_Count
  830.    0 SpeakBorder s! bd_NextBorder
  831.  
  832. : Initialize20  ( -- )  Initialize19
  833.   SpeakVectorsLT[]  SpeakBorderLT s! bd_XY
  834.   SpeakVectorsBR[]  SpeakBorder   s! bd_XY
  835.   0                 SpeakBorderLT s! bd_NextBorder
  836.   SpeakBorderLT     SpeakBorder   s! bd_NextBorder
  837. ;
  838.  
  839.  
  840. IntuiText SpeakIText
  841.  
  842.     BLKP SpeakIText s! it_FrontPen
  843.     GRYP SpeakIText s! it_BackPen
  844.     JAM2 SpeakIText s! it_DrawMode
  845.        0 SpeakIText s! it_LeftEdge
  846.        0 SpeakIText s! it_TopEdge
  847.        0 SpeakIText s! it_NextText
  848.  
  849. : Initialize21  ( -- )  Initialize20
  850.     TestFont SpeakIText s! it_ITextFont
  851.     0" Speak" SpeakIText s! it_IText
  852. ;
  853.  
  854.  
  855.  
  856. Gadget SpeakGadget
  857.  
  858.     261 SpeakGadget s! gg_LeftEdge
  859.      79 SpeakGadget s! gg_TopEdge
  860.      40 SpeakGadget s! gg_Width
  861.       8 SpeakGadget s! gg_Height
  862.     GADGHCOMP  SpeakGadget s! gg_Flags
  863.     RELVERIFY GADGIMMEDIATE |   SpeakGadget s! gg_Activation
  864.     BOOLGADGET SpeakGadget s! gg_GadgetType
  865.       0 SpeakGadget s! gg_SelectRender
  866.       0 SpeakGadget s! gg_MutualExclude
  867.       0 SpeakGadget s! gg_SpecialInfo
  868.       0 SpeakGadget s! gg_GadgetID
  869.       0 SpeakGadget s! gg_UserData
  870.  
  871. : Initialize22  ( -- )  Initialize21
  872.     TranslateGadget SpeakGadget s! gg_NextGadget
  873.     SpeakBorder     SpeakGadget s! gg_GadgetRender
  874.     SpeakIText      SpeakGadget s! gg_GadgetText
  875. ;
  876.  
  877.  
  878. IntuiText LoopIText
  879.  
  880.     BLKP LoopIText s! it_FrontPen
  881.     GRYP LoopIText s! it_BackPen
  882.     JAM2 LoopIText s! it_DrawMode
  883.        4 LoopIText s! it_LeftEdge
  884.        0 LoopIText s! it_TopEdge
  885.        0 LoopIText s! it_NextText
  886.  
  887. Gadget LoopGadget
  888.  
  889.     208 LoopGadget s! gg_LeftEdge
  890.      79 LoopGadget s! gg_TopEdge
  891.      40 LoopGadget s! gg_Width
  892.       8 LoopGadget s! gg_Height
  893.     GADGHCOMP  LoopGadget s! gg_Flags
  894.     RELVERIFY GADGIMMEDIATE |  TOGGLESELECT | LoopGadget s! gg_Activation
  895.     BOOLGADGET LoopGadget s! gg_GadgetType
  896.       0 LoopGadget s! gg_SelectRender
  897.       0 LoopGadget s! gg_MutualExclude
  898.       0 LoopGadget s! gg_SpecialInfo
  899.       0 LoopGadget s! gg_GadgetID
  900.       0 LoopGadget s! gg_UserData
  901.  
  902. : Initialize22a  ( -- )  Initialize22
  903.     TestFont LoopIText s! it_ITextFont
  904.     0" Loop" LoopIText s! it_IText
  905.     SpeakGadget    LoopGadget s! gg_NextGadget
  906.     SpeakBorder    LoopGadget s! gg_GadgetRender
  907.     LoopIText      LoopGadget s! gg_GadgetText
  908. ;
  909.  
  910.  
  911.  
  912. \ /* Now the proportional gadgets. */
  913. \ /* Proportional Gadgets **************************************/
  914. \ /* The following variables are used to create proportional
  915. \  * Gadgets. These variables will be filled in with copies of
  916. \  * the generic Gadgetry below.
  917. \  */
  918. 0 value PropCount  0 -> PropCount       \ /* index to next available Gadget */
  919.  
  920. create PTextsBase    \ /* get copies of TPropText */
  921. NUMPROPS  sizeof() IntuiText * allot    here even-up dp !
  922. PTextsBase  here PTextsBase -  cell- erase
  923.  
  924. : Ptexts   ( ix -- addr )
  925.   sizeof() Intuitext *  PTextsBase +
  926. ;
  927.  
  928. \ IntuiText PTexts[NUMPROPS];    \ /* get copies of TPropText */
  929.  
  930.  
  931. \ /* dummy AUTOKNOB Images are required */
  932. create PImagesBase
  933. NUMPROPS  sizeof() Image * allot    here even-up dp !
  934. PImagesBase  here PImagesBase -  cell- erase
  935.  
  936. : PImages   ( ix -- addr )
  937.   sizeof() Image *  PImagesBase +
  938. ;
  939.  
  940. \ struct Image PImages[NUMPROPS];
  941.  
  942. \ /* These get copies of TPropInfo */
  943. create PInfosBase
  944. NUMPROPS  sizeof() PropInfo * allot    here even-up dp !
  945. PInfosBase  here PInfosBase -  cell- erase
  946.  
  947. : PInfos   ( ix -- addr )
  948.   sizeof() PropInfo *  PInfosBase +
  949. ;
  950.  
  951. \ struct PropInfo PInfos[NUMPROPS];
  952.  
  953. \ /* These get copies of TPropGadget */
  954. create PropsBase
  955. NUMPROPS  sizeof() Gadget * allot    here even-up dp !
  956. PropsBase  here PropsBase -  cell- erase
  957.  
  958. : Props   ( ix -- addr )
  959.   sizeof() Gadget *  PropsBase +
  960. ;
  961.  
  962. \ struct Gadget Props[NUMPROPS];
  963.  
  964. IntuiText TPropText
  965.  
  966.     BLKP TPropText s! it_FrontPen
  967.     GRYP TPropText s! it_BackPen
  968.     JAM1 TPropText s! it_DrawMode
  969.        0 TPropText s! it_LeftEdge
  970.      -10 TPropText s! it_TopEdge
  971.        0 TPropText s! it_NextText
  972.        0 TPropText s! it_IText        \ set at runtime
  973.  
  974. : Initialize23  ( -- )  Initialize22a
  975.     TestFont TPropText s! it_ITextFont
  976. ;
  977.  
  978.  
  979. PropInfo TpropInfo
  980.  
  981.     AUTOKNOB FREEHORIZ |  TPropInfo s! pi_Flags    
  982.          0 TPropInfo s! pi_HorizPot    
  983.          0 TPropInfo s! pi_VertPot    
  984.     $ 1fff TPropInfo s! pi_HorizBody        
  985.     $ 1fff TPropInfo s! pi_VertBody        
  986.          0 TPropInfo s! pi_CWidth    
  987.          0 TPropInfo s! pi_CHeight    
  988.          0 TPropInfo s! pi_HPotRes
  989.          0 TPropInfo s! pi_VPotRes    
  990.          0 TPropInfo s! pi_LeftBorder        
  991.          0 TPropInfo s! pi_TopBorder        
  992.  
  993.  
  994.  
  995.  
  996. \ /* this is the template for the Gadget of a horizontal */
  997. \ /* Proportional Gadget */
  998.  
  999. Gadget TPropGadget
  1000.  
  1001.                7 TPropGadget s! gg_LeftEdge
  1002.               12 TPropGadget s! gg_TopEdge
  1003.              115 TPropGadget s! gg_Width
  1004.               10 TPropGadget s! gg_Height
  1005. GADGHCOMP GADGIMAGE     |  TPropGadget s! gg_Flags
  1006. GADGIMMEDIATE RELVERIFY |  TPropGadget s! gg_Activation
  1007.       PROPGADGET TPropGadget s! gg_GadgetType
  1008.                0 TPropGadget s! gg_GadgetRender
  1009.                0 TPropGadget s! gg_SelectRender
  1010.                0 TPropGadget s! gg_GadgetText
  1011.                0 TPropGadget s! gg_MutualExclude
  1012.                0 TPropGadget s! gg_SpecialInfo
  1013.                0 TPropGadget s! gg_GadgetID
  1014.                0 TPropGadget s! gg_UserData
  1015.  
  1016. : Initialize24  ( -- )  Initialize23
  1017.     LoopGadget    TPropGadget s! gg_NextGadget
  1018. ;
  1019.  
  1020.  
  1021.  
  1022. \ JForth has special operators for opening libraries.  These
  1023. \ library pointers exist in JForth as INTUITION_LIB and
  1024. \ GRAPHICS_LIB, but are not normally necessary to reference,
  1025. \ except when actually compiling a call into that library...
  1026. \
  1027. \ struct IntuitionBase *IntuitionBase = 0;
  1028. \ struct GfxBase *GfxBase = 0;
  1029.  
  1030. \ /* Only one menu. */
  1031.  
  1032. 0 value MenuNumber
  1033. 0 value TheMenu
  1034. 0 value TheItem
  1035.  
  1036. IntuiText MenuItemText
  1037.  
  1038.     GRYP MenuItemText s! it_FrontPen
  1039.     BLKP MenuItemText s! it_BackPen
  1040.     JAM2 MenuItemText s! it_DrawMode
  1041.        0 MenuItemText s! it_LeftEdge
  1042.        0 MenuItemText s! it_TopEdge
  1043.        0 MenuItemText s! it_NextText
  1044.  
  1045. : Initialize25  ( -- )  Initialize24
  1046.     TestFont MenuItemText s! it_ITextFont
  1047.     0" About SpeechToy..." MenuItemText s! it_IText
  1048. ;
  1049.  
  1050.  
  1051. MenuItem MyMenuItem
  1052.  
  1053.        0 MyMenuItem s! mi_NextItem    
  1054.        0 MyMenuItem s! mi_LeftEdge
  1055.        0 MyMenuItem s! mi_TopEdge    
  1056.      150 MyMenuItem s! mi_Width
  1057.        8 MyMenuItem s! mi_Height        
  1058.     ITEMTEXT ITEMENABLED | HIGHCOMP |  MyMenuItem s! mi_Flags        
  1059.        0 MyMenuItem s! mi_MutualExclude        
  1060.        0 MyMenuItem s! mi_ItemFill        
  1061.        0 MyMenuItem s! mi_SelectFill        
  1062.        0 MyMenuItem s! mi_Command        
  1063.        0 MyMenuItem s! mi_SubItem    
  1064. MENUNULL MyMenuItem s! mi_NextSelect
  1065.  
  1066. : Initialize26  ( -- )  Initialize25
  1067.     MenuItemText MyMenuItem s! mi_ItemFill
  1068. ;
  1069.  
  1070. Menu Mymenu
  1071.  
  1072.        0 Mymenu s! mu_NextMenu    
  1073.        0 Mymenu s! mu_LeftEdge
  1074.        0 Mymenu s! mu_TopEdge    
  1075.      150 Mymenu s! mu_Width
  1076.        0 Mymenu s! mu_Height    
  1077. MENUENABLED Mymenu s! mu_Flags        
  1078.        0 Mymenu s! mu_MenuName        
  1079.        0 Mymenu s! mu_FirstItem
  1080.        0 Mymenu s! mu_JazzX
  1081.        0 Mymenu s! mu_JazzY
  1082.        0 Mymenu s! mu_BeatX
  1083.        0 Mymenu s! mu_BeatY
  1084.  
  1085. : Initialize27  ( -- )  Initialize26
  1086.     0" SpeachToy Menu" Mymenu s! mu_MenuName
  1087.             MyMenuItem Mymenu s! mu_FirstItem
  1088. ;
  1089.  
  1090.  
  1091. IntuiText ReqText1
  1092.  
  1093.     GRYP ReqText1 s! it_FrontPen
  1094.     BLKP ReqText1 s! it_BackPen
  1095.     JAM2 ReqText1 s! it_DrawMode
  1096.        5 ReqText1 s! it_LeftEdge
  1097.       23 ReqText1 s! it_TopEdge
  1098.        0 ReqText1 s! it_ITextFont    
  1099.        0 ReqText1 s! it_IText        
  1100.        0 ReqText1 s! it_NextText
  1101.  
  1102. : Initialize28  ( -- )  Initialize27
  1103.     TestFont ReqText1 s! it_ITextFont
  1104.     0" Version 1.1  21 Dec, 1985 - 1.2 (in JForth) 6 Apr, 1994" ReqText1 s! it_IText
  1105. ;
  1106.  
  1107. IntuiText ReqText2
  1108.  
  1109.     GRYP ReqText2 s! it_FrontPen
  1110.     BLKP ReqText2 s! it_BackPen
  1111.     JAM2 ReqText2 s! it_DrawMode
  1112.        5 ReqText2 s! it_LeftEdge
  1113.       13 ReqText2 s! it_TopEdge
  1114.        0 ReqText2 s! it_ITextFont    
  1115.        0 ReqText2 s! it_IText        
  1116.        0 ReqText2 s! it_NextText
  1117.  
  1118. : Initialize29  ( -- )  Initialize28
  1119.     TestFont ReqText2 s! it_ITextFont
  1120.     ReqText1 ReqText2 s! it_NextText
  1121.     0"                  Freeware - Public Domain " ReqText2 s! it_IText
  1122. ;
  1123.  
  1124. IntuiText ReqText3
  1125.  
  1126.     GRYP ReqText3 s! it_FrontPen
  1127.     BLKP ReqText3 s! it_BackPen
  1128.     JAM2 ReqText3 s! it_DrawMode
  1129.        5 ReqText3 s! it_LeftEdge
  1130.        3 ReqText3 s! it_TopEdge
  1131.        0 ReqText3 s! it_ITextFont    
  1132.        0 ReqText3 s! it_IText        
  1133.        0 ReqText3 s! it_NextText
  1134.  
  1135. : Initialize30  ( -- )  Initialize29
  1136.     TestFont ReqText3 s! it_ITextFont
  1137.     ReqText2 ReqText3 s! it_NextText
  1138.     0" Written by David M Lucas, ported to JForth by Mike Haas" ReqText3 s! it_IText
  1139. ;
  1140.  
  1141. IntuiText OKIText
  1142.  
  1143.     GRYP OKIText s! it_FrontPen
  1144.     BLKP OKIText s! it_BackPen
  1145.     JAM2 OKIText s! it_DrawMode
  1146.        6 OKIText s! it_LeftEdge
  1147.        3 OKIText s! it_TopEdge
  1148.        0 OKIText s! it_ITextFont    
  1149.        0 OKIText s! it_IText        
  1150.        0 OKIText s! it_NextText
  1151.  
  1152. : Initialize31  ( -- )  Initialize30
  1153.     TestFont OKIText s! it_ITextFont
  1154.     0" OK"   OKIText s! it_IText
  1155. ;
  1156.  
  1157.  
  1158. 0 value AboutRequester
  1159.  
  1160. 0 value autoret
  1161. 0 value ControlWindow   0 -> ControlWindow
  1162. 0 value FaceWindow      0 -> FaceWindow
  1163. 0 value MyIntuiMessage
  1164.  
  1165. NewWindow NewControlWindow
  1166.  
  1167.         0 NewControlWindow s! nw_LeftEdge
  1168.        11 NewControlWindow s! nw_TopEdge        
  1169. CONTWINDW NewControlWindow s! nw_Width
  1170. CONTWINDH NewControlWindow s! nw_Height            
  1171.        -1 NewControlWindow s! nw_DetailPen
  1172.        -1 NewControlWindow s! nw_BlockPen        
  1173. GADGETUP  CLOSEWINDOW | MENUPICK |  NewControlWindow s! nw_IDCMPFlags            
  1174. WINDOWDRAG  WINDOWDEPTH | WINDOWCLOSE |
  1175.    GIMMEZEROZERO | ACTIVATE |    NewControlWindow s! nw_Flags            
  1176.         0 NewControlWindow s! nw_FirstGadget
  1177.         0 NewControlWindow s! nw_CheckMark
  1178.         0 NewControlWindow s! nw_Title            
  1179.         0 NewControlWindow s! nw_Screen
  1180.         0 NewControlWindow s! nw_BitMap
  1181.        20 NewControlWindow s! nw_MinWidth
  1182.        20 NewControlWindow s! nw_MinHeight    
  1183. CONTWINDW NewControlWindow s! nw_MaxWidth
  1184. CONTWINDH NewControlWindow s! nw_MaxHeight    
  1185. WBENCHSCREEN NewControlWindow s! nw_Type
  1186.  
  1187. : Initialize32  ( -- )  Initialize31
  1188.     [ NUMPROPS 1- ] literal Props NewControlWindow s! nw_FirstGadget
  1189.                     0" SpeechToy (written in JForth!)" NewControlWindow s! nw_Title
  1190. ;
  1191.  
  1192. NewWindow NewFaceWindow
  1193.  
  1194. CONTWINDW NewFaceWindow s! nw_LeftEdge
  1195.        11 NewFaceWindow s! nw_TopEdge        
  1196. FACEWINDW 2* NewFaceWindow s! nw_Width
  1197. FACEWINDH NewFaceWindow s! nw_Height            
  1198.        -1 NewFaceWindow s! nw_DetailPen
  1199.        -1 NewFaceWindow s! nw_BlockPen        
  1200. SIZEVERIFY  NEWSIZE |  MENUPICK |  NewFaceWindow s! nw_IDCMPFlags            
  1201. WINDOWDRAG  WINDOWDEPTH | WINDOWSIZING |
  1202.    SIZEBBOTTOM | GIMMEZEROZERO | ACTIVATE |    NewFaceWindow s! nw_Flags            
  1203.         0 NewFaceWindow s! nw_FirstGadget
  1204.         0 NewFaceWindow s! nw_CheckMark
  1205.         0 NewFaceWindow s! nw_Title            
  1206.         0 NewFaceWindow s! nw_Screen
  1207.         0 NewFaceWindow s! nw_BitMap
  1208. FACEWINDW NewFaceWindow s! nw_MinWidth
  1209. FACEWINDH NewFaceWindow s! nw_MinHeight    
  1210.       640 NewFaceWindow s! nw_MaxWidth
  1211.       200 NewFaceWindow s! nw_MaxHeight    
  1212. WBENCHSCREEN NewFaceWindow s! nw_Type
  1213.  
  1214. : Initialize33  ( -- )  Initialize32
  1215.     0" Face" NewFaceWindow s! nw_Title
  1216. ;
  1217.  
  1218. ' Initialize33 is Initialize
  1219.  
  1220.  
  1221. create FemaleIData[]
  1222. \ /*   ----      -  These nibbles matter to image. */
  1223.      $ 0000 w, $ 0000 w,
  1224.      $ 00F0 w, $ 1000 w,
  1225.      $ 0198 w, $ 1000 w,
  1226.      $ 030C w, $ 1000 w,
  1227.      $ 0198 w, $ 1000 w,
  1228.      $ 00F0 w, $ 1000 w,
  1229.      $ 0060 w, $ 1000 w,
  1230.      $ 01F8 w, $ 1000 w,
  1231.      $ 0060 w, $ 1000 w,
  1232.      $ ffff w, $ f000 w,
  1233.  
  1234.      $ ffff w, $ f000 w,
  1235.      $ 8000 w, $ 0000 w,
  1236.      $ 8000 w, $ 0000 w,
  1237.      $ 8000 w, $ 0000 w,
  1238.      $ 8000 w, $ 0000 w,
  1239.      $ 8000 w, $ 0000 w,
  1240.      $ 8000 w, $ 0000 w,
  1241.      $ 8000 w, $ 0000 w,
  1242.      $ 8000 w, $ 0000 w,
  1243.      $ 0000 w, $ 0000 w,
  1244.    
  1245. here FemaleIData[] - constant FemaleIData[]SIZE
  1246.  
  1247. create MaleIData[]
  1248. \ /*   ----      -  These nibbles matter to image. */
  1249.      $ 0000 w, $ 0000 w,
  1250.      $ 003E w, $ 1000 w,
  1251.      $ 000E w, $ 1000 w,
  1252.      $ 0036 w, $ 1000 w,
  1253.      $ 01E0 w, $ 1000 w,
  1254.      $ 0330 w, $ 1000 w,
  1255.      $ 0618 w, $ 1000 w,
  1256.      $ 0330 w, $ 1000 w,
  1257.      $ 01E0 w, $ 1000 w,
  1258.      $ ffff w, $ f000 w,
  1259.    
  1260.      $ ffff w, $ f000 w,
  1261.      $ 8000 w, $ 0000 w,
  1262.      $ 8000 w, $ 0000 w,
  1263.      $ 8000 w, $ 0000 w,
  1264.      $ 8000 w, $ 0000 w,
  1265.      $ 8000 w, $ 0000 w,
  1266.      $ 8000 w, $ 0000 w,
  1267.      $ 8000 w, $ 0000 w,
  1268.      $ 8000 w, $ 0000 w,
  1269.      $ 0000 w, $ 0000 w,
  1270.    
  1271.    
  1272. here MaleIData[] - constant MaleIData[]SIZE
  1273.  
  1274. create HumanIData[]
  1275. \ /*   ----       ----       --   These nibbles matter to image. */
  1276.      $ 0000 w,  $ 0000 w,  $ 0000 w,
  1277.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1278.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1279.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1280.      $ 0007 w,  $ 9E00 w,  $ 0100 w,
  1281.      $ 0001 w,  $ 8600 w,  $ 0100 w,
  1282.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1283.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1284.      $ 0000 w,  $ 2000 w,  $ 0100 w,
  1285.      $ 0000 w,  $ 1000 w,  $ 0100 w,
  1286.      $ 0000 w,  $ 0800 w,  $ 0100 w,
  1287.      $ 0000 w,  $ 7C00 w,  $ 0100 w,
  1288.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1289.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1290.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1291.      $ 0000 w,  $ 7800 w,  $ 0100 w,
  1292.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1293.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1294.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1295.      $ ffff w,  $ ffff w,  $ ff00 w,
  1296.    
  1297.      $ ffff w,  $ ffff w,  $ ff00 w,
  1298.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1299.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1300.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1301.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1302.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1303.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1304.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1305.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1306.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1307.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1308.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1309.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1310.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1311.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1312.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1313.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1314.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1315.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1316.      $ 0000 w,  $ 0000 w,  $ 0000 w,
  1317.    
  1318. here HumanIData[] - constant HumanIData[]SIZE
  1319.  
  1320. create RobotIData[]
  1321. \ /*   ----       ----       --   These nibbles matter to image. */
  1322.      $ 0000 w,  $ 0000 w,  $ 0000 w,
  1323.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1324.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1325.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1326.      $ 0007 w,  $ 9E00 w,  $ 0100 w,
  1327.      $ 0004 w,  $ 9200 w,  $ 0100 w,
  1328.      $ 0007 w,  $ 9E00 w,  $ 0100 w,
  1329.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1330.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1331.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1332.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1333.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1334.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1335.      $ 0001 w,  $ F800 w,  $ 0100 w,
  1336.      $ 0001 w,  $ 0800 w,  $ 0100 w,
  1337.      $ 0001 w,  $ F800 w,  $ 0100 w,
  1338.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1339.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1340.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1341.      $ ffff w,  $ ffff w,  $ ff00 w,
  1342.    
  1343.      $ ffff w,  $ ffff w,  $ ff00 w,
  1344.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1345.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1346.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1347.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1348.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1349.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1350.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1351.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1352.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1353.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1354.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1355.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1356.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1357.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1358.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1359.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1360.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1361.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1362.      $ 0000 w,  $ 0000 w,  $ 0000 w,
  1363.    
  1364. here RobotIData[] - constant RobotIData[]SIZE
  1365.  
  1366. create FaceIData[]
  1367. \ /*   ----       ----       --   These nibbles matter to image. */
  1368.      $ 0000 w,  $ 0000 w,  $ 0000 w,
  1369.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1370.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1371.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1372.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1373.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1374.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1375.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1376.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1377.      $ ffff w,  $ ffff w,  $ ff00 w,
  1378.  
  1379.      $ ffff w,  $ ffff w,  $ ff00 w,
  1380.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1381.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1382.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1383.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1384.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1385.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1386.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1387.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1388.      $ 0000 w,  $ 0000 w,  $ 0000 w,
  1389.  
  1390. here FaceIData[] - constant FaceIData[]SIZE
  1391.  
  1392. create StopIData[]
  1393. \ /*   ----       ----       --   These nibbles matter to image. */
  1394.      $ 0000 w,  $ 0000 w,  $ 0000 w,
  1395.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1396.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1397.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1398.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1399.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1400.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1401.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1402.      $ 0000 w,  $ 0000 w,  $ 0100 w,
  1403.      $ ffff w,  $ ffff w,  $ ff00 w,
  1404.  
  1405.      $ ffff w,  $ ffff w,  $ ff00 w,
  1406.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1407.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1408.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1409.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1410.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1411.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1412.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1413.      $ 8000 w,  $ 0000 w,  $ 0000 w,
  1414.      $ 0000 w,  $ 0000 w,  $ 0000 w,
  1415.  
  1416.  
  1417.    
  1418. here StopIData[] - constant StopIData[]SIZE
  1419.  
  1420.    
  1421. 0 value FemaleIData_chip    0 -> FemaleIData_chip
  1422. 0 value MaleIData_chip    0 -> MaleIData_chip
  1423. 0 value HumanIData_chip    0 -> HumanIData_chip
  1424. 0 value RobotIData_chip    0 -> RobotIData_chip
  1425. 0 value FaceIData_chip    0 -> FaceIData_chip
  1426. 0 value StopIData_chip    0 -> StopIData_chip
  1427.  
  1428. \ /** start of code ***************************/
  1429.  
  1430. defer menumessage
  1431. defer gadgetmessage
  1432. defer DrawFace
  1433. defer MyCleanup
  1434. defer InitImages
  1435. defer freeimages
  1436. defer DoSpeak
  1437.  
  1438. 0 Value DoLoop
  1439. 0 value Aborted
  1440.  
  1441. : main  { | signals MIClass MICode MIAddress -- }
  1442.  
  1443.    Initialize  0 -> DoLoop  0 -> Aborted
  1444.  
  1445.    \ /* let MyCleanup know these signals not allocated yet */
  1446.    
  1447.    -1 talk_port s! mp_SigBit
  1448.    -1 read_port s! mp_SigBit
  1449.  
  1450.    \ /* Open those libraries that the program uses directly */
  1451.    
  1452.    LIB_QUIT off  \ LIBRARY_VERSION LIBVersion !
  1453.    intuition?  intuition_lib @ 0=
  1454.    IF
  1455. [ exists? STDEBUG .if ]
  1456.       >newline ." Can't open the intuition library" cr
  1457. [ .then ]
  1458.       MyCleanup
  1459.       quit
  1460.    THEN
  1461.  
  1462.    LIB_QUIT off  \ LIBRARY_VERSION LIBVersion !
  1463.    graphics?  graphics_lib @ 0=
  1464.    IF
  1465. [ exists? STDEBUG .if ]
  1466.       >newline ." Can't open the graphics library" cr
  1467. [ .then ]
  1468.       MyCleanup
  1469.       quit
  1470.    THEN
  1471.  
  1472.    LIB_QUIT off  \ LIBRARY_VERSION LIBVersion !
  1473.    translator?  translator_lib @ 0=
  1474.    IF
  1475. [ exists? STDEBUG .if ]
  1476.       >newline ." Can't open the translator library" cr
  1477. [ .then ]
  1478.       MyCleanup
  1479.       quit
  1480.    THEN
  1481.  
  1482.    \ /* Open the device */
  1483.    voice_io sizeof() narrator_rb erase
  1484.    0" narrator.device" 0 voice_io 0  OpenDevice() dup -> NarratorOpenError
  1485.    IF
  1486. [ exists? STDEBUG .if ]
  1487.       >newline ." Can't open the narrator device" cr
  1488. [ .then ]
  1489.       MyCleanup
  1490.       quit
  1491.    THEN
  1492.  
  1493.    voice_io .. ndi_message s@ io_Device s@ lib_version -> NarratorVersion
  1494.    
  1495. \    /* This is where the proportional gadgets are set up, using
  1496. \     * the templates that were declared staticly.
  1497. \     */
  1498.    \ 'C' for loop init...
  1499.    0 -> PropCount
  1500.    BEGIN
  1501.       \
  1502.       \ C for loop test
  1503.       PropCount NUMPROPS <
  1504.    WHILE
  1505.       \
  1506.       \ C for loop body
  1507.       TPropText    PropCount PTexts  sizeof() Intuitext move
  1508.       TPropGadget  PropCount Props   sizeof() Gadget    move
  1509.       TPropInfo    PropCount PInfos  sizeof() PropInfo  move
  1510.       PropCount PTexts   PropCount Props s! gg_GadgetText
  1511.       PropCount PImages  PropCount Props s! gg_GadgetRender
  1512.       PropCount PInfos   PropCount Props s! gg_SpecialInfo
  1513.       PropCount
  1514.       CASE
  1515.          0 OF
  1516.             0" Sample Freq:"  PropCount PTexts s! it_IText
  1517.             [ DEFFREQ MAXFREQ = ] literal
  1518.             IF
  1519.                65535
  1520.             ELSE
  1521.                [ DEFFREQ MINFREQ -  16 <<  MAXFREQ MINFREQ - / ] literal
  1522.             THEN
  1523.             PropCount PInfos s! pi_HorizPot
  1524.          ENDOF
  1525.          1 OF
  1526.             0" Rate:"  PropCount PTexts s! it_IText
  1527.             PropCount Props s@ gg_TopEdge  22 +  PropCount Props s! gg_TopEdge
  1528.             PropCount 1- Props    PropCount Props s! gg_NextGadget
  1529.             [ DEFRATE MAXRATE = ] literal
  1530.             IF
  1531.                65535
  1532.             ELSE
  1533.                [ DEFRATE MINRATE -  16 <<  MAXRATE MINRATE - / ] literal
  1534.             THEN
  1535.             PropCount PInfos s! pi_HorizPot
  1536.          ENDOF
  1537.          2 OF
  1538.             0" Pitch:"  PropCount PTexts s! it_IText
  1539.             PropCount Props s@ gg_LeftEdge  183 +  PropCount Props s! gg_LeftEdge
  1540.             PropCount 1- Props    PropCount Props s! gg_NextGadget
  1541.             [ DEFPITCH MAXPITCH = ] literal
  1542.             IF
  1543.                65535
  1544.             ELSE
  1545.                [ DEFPITCH MINPITCH -  16 <<  MAXPITCH MINPITCH - / ] literal
  1546.             THEN
  1547.             PropCount PInfos s! pi_HorizPot
  1548.          ENDOF
  1549.          3 OF
  1550.             0" Volume:"  PropCount PTexts s! it_IText
  1551.             PropCount Props s@ gg_TopEdge  22 +  PropCount Props s! gg_TopEdge
  1552.             PropCount Props s@ gg_LeftEdge  183 +  PropCount Props s! gg_LeftEdge
  1553.             PropCount 1- Props    PropCount Props s! gg_NextGadget
  1554.             [ DEFVOL MAXVOL = ] literal
  1555.             IF
  1556.                65535
  1557.             ELSE
  1558.                [ DEFVOL MINVOL -  16 <<  MAXVOL MINVOL - / ] literal
  1559.             THEN
  1560.             PropCount PInfos s! pi_HorizPot
  1561.          ENDOF
  1562.       ENDCASE
  1563.       \
  1564.       \ C for loop iteration
  1565.       1 +-> PropCount
  1566.    REPEAT
  1567. \   
  1568. \  /* Now allocate memory accessable by the chips for images */
  1569.    InitImages false =
  1570.    IF
  1571. [ exists? STDEBUG .if ]
  1572.       >newline ." Couldn't Allocate Images in chip memory." cr
  1573. [ .then ]
  1574.       MyCleanup
  1575.       quit
  1576.    THEN
  1577. \   
  1578. \  /* Set up the write port, allocate the signal, */
  1579. \  /* and the message */
  1580.    NT_MSGPORT  talk_port .. mp_Node s! ln_Type
  1581.    0  talk_port s! mp_Flags
  1582.    -1 AllocSignal()  dup talk_port s! mp_SigBit  -1 =
  1583.    IF
  1584. [ exists? STDEBUG .if ]
  1585.       >newline ." Couldn't Allocate talk Signal bit" cr
  1586. [ .then ]
  1587.       MyCleanup
  1588.       quit
  1589.    THEN
  1590. \   
  1591.    0 FindTask()  talk_port s! mp_SigTask
  1592.    talk_port .. mp_MsgList  NewList()
  1593. \
  1594. \    /* Set up the read port, allocate the signal, */
  1595. \    /*  and the message */
  1596.    NT_MSGPORT  read_port .. mp_Node s! ln_Type
  1597.    0  read_port s! mp_Flags
  1598.    -1 AllocSignal()  dup read_port s! mp_SigBit  -1 =
  1599.    IF
  1600. [ exists? STDEBUG .if ]
  1601.       >newline ." Couldn't Allocate read Signal bit" cr
  1602. [ .then ]
  1603.       MyCleanup
  1604.       quit
  1605.    THEN
  1606. \   
  1607.    0 FindTask()  read_port s! mp_SigTask
  1608.    read_port .. mp_MsgList  NewList()
  1609. \ 
  1610. \  /* Set up the write channel information */
  1611.    0 audio_chan  voice_io s! ndi_ch_masks
  1612.    4 voice_io s! ndi_nm_masks
  1613.    0 voice_io s! ndi_mouths
  1614.    talk_port  voice_io .. ndi_message .. io_Message s! mn_ReplyPort
  1615.    CMD_WRITE  voice_io .. ndi_message s! io_Command
  1616.            0  voice_io .. ndi_message s! io_Offset
  1617.    PhonBuffer voice_io .. ndi_message s! io_Data
  1618. \  talk_port  voice_io .. ndi_message .. io_Message s! mn_ReplyPort
  1619.    sizeof() narrator_rb  voice_io .. ndi_message .. io_Message s! mn_Length
  1620. \
  1621. \  /* Set up the read channel information */
  1622.    voice_io   mouth_io .. mrb_voice   sizeof() narrator_rb  move
  1623.    NarratorVersion 37 >=
  1624.    IF
  1625.            0  mouth_io s! mrb_width
  1626.            0  mouth_io s! mrb_height
  1627.    ELSE
  1628.            0  mouth_io .. mrb_voice s! ndi_F0enthusiasm
  1629.            0  mouth_io .. mrb_voice s! ndi_F0perturb
  1630.    THEN
  1631.    read_port  mouth_io .. mrb_voice .. ndi_message .. io_Message s! mn_ReplyPort
  1632.     CMD_READ  mouth_io .. mrb_voice .. ndi_message s! io_Command
  1633.            0  mouth_io .. mrb_voice .. ndi_message s! io_Error
  1634.    FaceWindow 0=
  1635.    IF
  1636.       NewControlWindow OpenWindow()  dup -> ControlWindow 0=
  1637.       IF
  1638. [ exists? STDEBUG .if ]
  1639.          >newline ." Couldn't open the control window." cr
  1640. [ .then ]
  1641.          MyCleanup
  1642.          quit
  1643.       THEN
  1644.    THEN
  1645. \
  1646. \  /* fill background of window */
  1647.    ControlWindow s@ wd_RPort  GRYP   SetAPen()
  1648.    ControlWindow s@ wd_RPort  0 0  ControlWindow s@ wd_GZZWidth
  1649.       ControlWindow s@ wd_GZZWidth  RectFill()
  1650.    NUMPROPS 1- Props  ControlWindow  0    RefreshGadgets()
  1651.  
  1652.    ControlWindow MyMenu  SetMenuStrip()
  1653.  
  1654. \ /* !!! Ah, But what if FaceWindow's not been opened? */
  1655.    BEGIN
  1656. \       /* ever wait for a signal and process it */
  1657. \       /* wait lets the rest of the system run, */
  1658. \       /* this program sleeps */
  1659.       1  ControlWindow s@ wd_UserPort s@ mp_SigBit  <<
  1660.       FaceWindow
  1661.       IF
  1662.          1  FaceWindow    s@ wd_UserPort s@ mp_SigBit  <<  OR
  1663.       THEN
  1664.       1  voice_io .. ndi_message .. io_Message
  1665.                   s@ mn_ReplyPort s@ mp_SigBit      <<  OR
  1666.       1  mouth_io .. mrb_voice .. ndi_message .. io_Message
  1667.                   s@ mn_ReplyPort s@ mp_SigBit      <<  OR   Wait() -> signals
  1668. \
  1669. \     /* now check to see to what we owe the intrusion */
  1670. \
  1671.       1 ControlWindow s@ wd_UserPort s@ mp_SigBit <<   signals AND
  1672.       IF
  1673. \
  1674. \        /* Process the Intuition message */
  1675.          BEGIN
  1676.             ControlWindow s@ wd_UserPort GetMsg() dup -> MyIntuiMessage
  1677.          WHILE
  1678. \             /* Get all the needed info and give message back */
  1679.             MyIntuiMessage s@ im_Class -> MIClass
  1680.             
  1681.             MyIntuiMessage s@ im_Code -> MICode
  1682.             MyIntuiMessage s@ im_IAddress -> MIAddress
  1683.             MyIntuiMessage ReplyMsg()
  1684. \             /* Now, what was it you wanted? */
  1685.             MIClass
  1686.             CASE
  1687.                MENUPICK of
  1688.                   MICode ControlWindow menumessage
  1689.                endof
  1690.                GADGETUP of
  1691.                   MIAddress ControlWindow gadgetmessage
  1692.                endof
  1693.                CLOSEWINDOW of
  1694.                   BEGIN
  1695.                      ControlWindow s@ wd_UserPort GetMsg() dup -> MyIntuiMessage
  1696.                   WHILE
  1697.                      MyIntuiMessage ReplyMsg()
  1698.                   REPEAT
  1699.                   MyCleanUp
  1700.                   quit
  1701.                endof
  1702. [ exists? STDEBUG .if ]
  1703.                    >newline ." Unhandled Message Received." cr
  1704. [ .then ]
  1705.             ENDCASE
  1706.          REPEAT
  1707.       THEN
  1708. \       /* Woken by intuition for FaceWindow*/
  1709.       FaceWindow
  1710.       IF
  1711.          1 FaceWindow s@ wd_UserPort s@ mp_SigBit <<   signals AND
  1712.          IF
  1713.    \
  1714.    \        /* Process the Intuition message */
  1715.             BEGIN
  1716.                FaceWindow s@ wd_UserPort GetMsg() dup -> MyIntuiMessage
  1717.             WHILE
  1718.    \             /* Get all the needed info and give message back */
  1719.                MyIntuiMessage s@ im_Class
  1720.                CASE
  1721.                   SIZEVERIFY of
  1722.                      MyIntuiMessage ReplyMsg()
  1723.                   endof
  1724.                   MENUPICK of
  1725.                      MICode FaceWindow menumessage
  1726.                      MyIntuiMessage ReplyMsg()
  1727.                   endof
  1728.                   NEWSIZE of
  1729.                      DrawFace
  1730.                      MyIntuiMessage ReplyMsg()
  1731.                   endof
  1732.    [ exists? STDEBUG .if ]
  1733.                       >newline ." Unhandled Message Received." cr
  1734.    [ .then ]
  1735.                      MyIntuiMessage ReplyMsg()
  1736.                ENDCASE
  1737.             REPEAT
  1738.          THEN
  1739.       THEN
  1740. \       /* A voice SendIO (Write) has completed */
  1741.       1  voice_io .. ndi_message .. io_Message
  1742.                   s@ mn_ReplyPort s@ mp_SigBit      <<   signals AND
  1743.       IF
  1744. \
  1745. \          /* Was it Sucessful? filter out the abort error */
  1746.          voice_io .. ndi_message s@ io_Error   -2 =
  1747.          IF
  1748.             0 voice_io .. ndi_message s! io_Error
  1749.          THEN
  1750.          voice_io .. ndi_message s@ io_Error
  1751.          IF
  1752. [ exists? STDEBUG .if ]
  1753.             >newline ." Narrator won't. ("
  1754.             voice_io .. ndi_message s@ io_Error 0 .r ascii ) emit cr
  1755. [ .then ]
  1756. \             /* flash this screen */
  1757.             ControlWindow s@ wd_WScreen  DisplayBeep()
  1758.  
  1759. \             /* let user see where phoneme string was bad. */
  1760.             ControlWIndow PhonStrGadget RemoveGadget() -> ii
  1761. \             /* move the cursor to the error char */
  1762.             voice_io .. ndi_message s@ io_Actual 1-  PhonInfo s! si_BufferPos
  1763. \             /* assure cursor (error point) is shown in gad. */
  1764. \             /* within 29 (number of chars shown) of front */
  1765.             voice_io .. ndi_message s@ io_Actual  29  <
  1766.             IF
  1767.                0  PhonInfo s! si_DispPos
  1768.             ELSE
  1769. \             /* within 29 of end */
  1770.                voice_io .. ndi_message s@ io_Length
  1771.                voice_io .. ndi_message s@ io_Actual  -  29  <
  1772.                IF
  1773.                   voice_io .. ndi_message s@ io_Length
  1774.                   PhonInfo s! si_DispPos
  1775.                ELSE
  1776.                   voice_io .. ndi_message s@ io_Actual  15 -
  1777.                   PhonInfo s! si_DispPos
  1778.                THEN
  1779.             THEN
  1780.             ControlWIndow PhonStrGadget ii AddGadget()
  1781.             PhonStrGadget ControlWIndow  0 RefreshGadgets()
  1782.             0 voice_io .. ndi_message s! io_Error
  1783.          THEN
  1784. \          SpeakGadget s@ gg_Flags  GADGDISABLED xor  SpeakGadget s! gg_Flags
  1785. \          FaceGadget  s@ gg_Flags  GADGDISABLED xor  FaceGadget  s! gg_Flags
  1786.  
  1787.          FaceWindow 0=
  1788.          IF
  1789.             DoLoop  Aborted 0= and
  1790.             IF
  1791.                DoSpeak
  1792.             THEN
  1793.             0 -> Aborted
  1794.          THEN
  1795.          DoLoop 0=
  1796.          IF
  1797.             SpeakGadget ControlWIndow  0 OnGadget()
  1798.             FaceGadget  ControlWIndow  0 OnGadget()
  1799.          THEN
  1800.       THEN
  1801. \       /* A mouth DoIO (Read) has completed */
  1802.       1  mouth_io .. mrb_voice .. ndi_message .. io_Message
  1803.                   s@ mn_ReplyPort s@ mp_SigBit      <<   signals AND
  1804.       IF
  1805. \ >newline voice_io .. ndi_message s@ io_Error  .
  1806. \ mouth_io .. mrb_voice .. ndi_message s@ io_Error  . cr
  1807.          FaceWindow s@ wd_WScreen .. sc_ViewPort  WaitBOVP()
  1808.          FaceWindow s@ wd_RPort  BLKP  SetAPen()
  1809.          FaceWindow s@ wd_RPort  0  EyesBottom  FaceWindow s@ wd_GZZWidth
  1810.               FaceWindow s@ wd_GZZHeight   RectFill()
  1811. \ >newline
  1812. \ ." mwm=" mouthWMult . ." mrb_w=" mouth_io s@ mrb_width .
  1813. \
  1814.          NarratorVersion 37 >=
  1815.          IF
  1816.             mouth_io s@ mrb_width
  1817.          ELSE
  1818.            mouth_io .. mrb_voice s@ ndi_F0enthusiasm
  1819.          THEN 
  1820.          MouthWMult 0=
  1821.          IF
  1822.             ( mouth_io s@ mrb_width )  2/
  1823.          ELSE
  1824.             ( mouth_io s@ mrb_width )  MouthWMult *
  1825.          THEN
  1826. \ dup ." lw=" . 
  1827.          -> LipWidth
  1828. \ ." mhm=" mouthHMult . ." mrb_h=" mouth_io s@ mrb_height .
  1829.          NarratorVersion 37 >=
  1830.          IF
  1831.             mouth_io s@ mrb_height
  1832.          ELSE
  1833.             mouth_io .. mrb_voice s@ ndi_F0perturb
  1834.          THEN 
  1835.          MouthHMult 0=
  1836.          IF
  1837.             ( mouth_io s@ mrb_height )  2/
  1838.          ELSE
  1839.             ( mouth_io s@ mrb_height )  MouthHMult *
  1840.          THEN
  1841. \ dup ." lh=" . cr
  1842.          -> LipHeight
  1843.          FaceWindow s@ wd_RPort  REDP  SetAPen()
  1844.          FaceWindow s@ wd_RPort
  1845.             XMouthCenter LipWidth -  YMouthCenter Move()
  1846.          FaceWindow s@ wd_RPort
  1847.             XMouthCenter  YMouthCenter LipHeight -  Draw()
  1848.          FaceWindow s@ wd_RPort
  1849.             XMouthCenter LipWidth +  YMouthCenter Draw()
  1850.          FaceWindow s@ wd_RPort
  1851.             XMouthCenter  YMouthCenter LipHeight +  Draw()
  1852.          FaceWindow s@ wd_RPort
  1853.             XMouthCenter LipWidth -  YMouthCenter Draw()
  1854. \          /* the narrator will give an error when the */
  1855. \          /* write has completed and I've tried to read */
  1856. \          /* so I stop trying when that happens */
  1857.          mouth_io .. mrb_voice .. ndi_message s@ io_Error   0=
  1858.          IF
  1859.             mouth_io SendIO()
  1860.          ELSE
  1861.             DoLoop  Aborted 0= and
  1862.             IF
  1863.                DoSpeak
  1864.             THEN
  1865.             0 -> Aborted
  1866.             DoLoop 0=
  1867.             IF
  1868.                SpeakGadget ControlWIndow  0 OnGadget()
  1869.                FaceGadget  ControlWIndow  0 OnGadget()
  1870.             THEN
  1871.          THEN
  1872.       THEN
  1873.       
  1874.    AGAIN
  1875. ;
  1876.  
  1877. \ /* a MENUPICK has been received, this
  1878. \  * routine takes the appropriate action
  1879. \  */
  1880. : |menumessage|  { code ww -- }
  1881.    code MENUNUM()
  1882.    CASE
  1883.       0 of
  1884.          code ITEMNUM()
  1885.          CASE
  1886.             0 of
  1887.                ww  ReqText3  0  OKIText  0  0  526  47  AutoRequest()
  1888.             endof
  1889.          ENDCASE
  1890.       endof
  1891.    ENDCASE
  1892. ;               ' |menumessage| is menumessage
  1893.  
  1894. : |DoSpeak|  ( -- )
  1895.    voice_io AbortIO()
  1896.    mouth_io AbortIO()
  1897.    0 -> Aborted
  1898.    SpeakGadget ControlWindow NULL  OffGadget()
  1899.    FaceGadget  ControlWindow NULL  OffGadget()
  1900.    PhonBuffer 0count nip  voice_io .. ndi_message s! io_Length
  1901.    voice_io SendIO()
  1902.    voice_io s@ ndi_mouths  1 =
  1903.    IF
  1904.       0  mouth_io .. mrb_voice .. ndi_message s! io_Error
  1905.       mouth_io  SendIO()
  1906.    THEN
  1907. ; ' |DoSpeak| is DoSpeak
  1908.  
  1909. \ /* a GADGETUP has been received, this
  1910. \  * routine takes the appropriate action
  1911. \  */
  1912. : |gadgetmessage|  { address ww | PropRange -- }
  1913.    address ModeGadget =
  1914.    IF
  1915.       ModeGadget s@ gg_Flags  SELECTED and
  1916.       IF
  1917.          ROBOTICF0
  1918.       ELSE
  1919.          NATURALF0
  1920.       THEN
  1921.       voice_io s! ndi_mode
  1922.    ELSE
  1923.    address FaceGadget =
  1924.    IF
  1925. \       /* tell the write that reads will be forthcomming */
  1926.       FaceGadget s@ gg_Flags  SELECTED and
  1927.       IF
  1928.           1 voice_io s! ndi_mouths
  1929.           NewFaceWindow OpenWindow() dup -> FaceWindow 0=
  1930.           IF
  1931. [ exists? STDEBUG .if ]
  1932.              >newline ." Couldn't open the face window." cr
  1933. [ .then ]
  1934.             MyCleanUp
  1935.             quit
  1936.          THEN
  1937.          FaceWindow  MyMenu  SetMenuStrip()
  1938.          DrawFace
  1939.       ELSE   \ /* FaceGadget de-SELECTed */
  1940.          0  voice_io s! ndi_mouths
  1941.          FaceWindow s@ wd_LeftEdge  NewFaceWindow s! nw_LeftEdge
  1942.          FaceWindow s@ wd_TopEdge  NewFaceWindow s! nw_TopEdge
  1943.          FaceWindow s@ wd_Width  NewFaceWindow s! nw_Width
  1944.          FaceWindow s@ wd_Height  NewFaceWindow s! nw_Height
  1945.          FaceWindow  CloseWindow()
  1946.          0 -> FaceWIndow
  1947.       THEN
  1948.    ELSE
  1949.    address StopGadget =
  1950.    IF
  1951.       voice_io AbortIO()
  1952.       0 voice_io .. ndi_message s! io_Error
  1953.       0 mouth_io .. mrb_voice .. ndi_message s! io_Error
  1954.       SpeakGadget ControlWIndow  0 OnGadget()
  1955.       FaceGadget  ControlWIndow  0 OnGadget()
  1956.       true -> aborted
  1957. \    /* Since this program changes a flag that intuition expects
  1958. \     * only the user to change (SELECTED bit), this program has
  1959. \     * to remove, then change, then add this gadget. Then by
  1960. \     * passing the address of this gadget to RefreshGadgets(),
  1961. \     * only the gadgets from here to the start of the list will
  1962. \     * be refreshed, which minimizes the visible flash that
  1963. \     * RefreshGadgets() can introduce.
  1964. \     * If one of the two gadgets (female/male) is hit, toggle
  1965. \     * the selection of the other gadget (since the gadget hit
  1966. \     * was toggled by intuition when it was hit).
  1967. \     */
  1968.    ELSE
  1969.    address FemaleGadget =
  1970.    IF
  1971.       Femalegadget s@ gg_Flags  SELECTED and
  1972.       IF
  1973.          FEMALE
  1974.       ELSE
  1975.          MALE
  1976.       THEN
  1977.       voice_io s! ndi_sex
  1978.       ControlWindow MaleGadget  RemoveGadget() -> ii
  1979.       MaleGadget s@ gg_Flags SELECTED xor  MaleGadget s! gg_Flags
  1980.       ControlWindow MaleGadget  ii  AddGadget()
  1981.       MaleGadget  ControlWindow ii RefreshGadgets()
  1982.    ELSE
  1983.    address MaleGadget =
  1984.    IF  ( 5 )
  1985.       Malegadget s@ gg_Flags  SELECTED and
  1986.       IF
  1987.          MALE
  1988.       ELSE
  1989.          FEMALE
  1990.       THEN
  1991.       voice_io s! ndi_sex
  1992.       ControlWindow FemaleGadget  RemoveGadget() -> ii
  1993.       FemaleGadget s@ gg_Flags SELECTED xor  FemaleGadget s! gg_Flags
  1994.       ControlWindow FemaleGadget  ii  AddGadget()
  1995.       MaleGadget  ControlWindow ii RefreshGadgets()
  1996.    ELSE
  1997. \    /* Since the program changes the contents of the string
  1998. \     * gadgets' buffer and it's size, which is something else
  1999. \     * intuition doesn't expect a program (as opposed to the
  2000. \     * user) to do. The program must remove, then change, then
  2001. \     * add this gadget, and then by passing the address of this
  2002. \     * gadget to RefreshGadgets(), only the gadgets from here
  2003. \     * to the start of the list will be refreshed, which
  2004. \     * minimizes the visible flash that RefreshGadgets() can
  2005. \     * introduce.
  2006. \     */
  2007.    address TranslateGadget =
  2008.    IF
  2009.       ControlWindow PhonStrgadget  removeGadget() -> ii
  2010.       EnglBuffer  EnglInfo s@ si_NumChars
  2011.       PhonBuffer  PhonInfo s@ si_MaxChars  Translate() dup -> TranslatorError
  2012.       IF
  2013. [ exists? STDEBUG .if ]
  2014.          >newline ." Translator won't. ("
  2015.          TranslatorError 0 .r ascii ) emit cr
  2016. [ .then ]
  2017. \             /* flash this screen */
  2018.          ControlWindow s@ wd_WScreen  DisplayBeep()
  2019.       THEN
  2020. \       /* Hey! NumChars includes the terminating NULL. */
  2021. \       /* This must be done. */
  2022.       voice_io .. ndi_message s@ io_Length  1+  PhonInfo s! si_NumChars
  2023.       PhonInfo s@ si_DispPos  voice_io .. ndi_message s@ io_Length  >
  2024.       IF
  2025.          voice_io .. ndi_message s@ io_Length  PhonInfo s! si_DispPos
  2026.       THEN
  2027.       ControlWindow  PhonStrGadget  ii  AddGadget()
  2028.       PhonStrGadget ControlWindow  0  RefreshGadgets()
  2029.    ELSE
  2030.    address SpeakGadget =
  2031.    IF
  2032.       DoSpeak
  2033.    ELSE
  2034.    address LoopGadget =
  2035.    IF
  2036.       DoLoop  IF 0 ELSE -1 THEN  -> DoLoop
  2037.    ELSE
  2038.    address EnglStrGadget =   \  /* do nothing */
  2039.    IF
  2040.    ELSE
  2041.    address PhonStrGadget =   \  /* do nothing */
  2042.    IF
  2043.    ELSE
  2044.    address  0 Props  =
  2045.    IF
  2046.    
  2047.       RNGFREQ -> PropRange
  2048.       0 PInfos s@ pi_HorizPot 2/   PropRange *  15 >>  MINFREQ +
  2049.                                               voice_io s! ndi_sampfreq
  2050. [ exists? STDEBUG .if ]
  2051.          >newline ." Freq. = "
  2052.          voice_io s@ ndi_sampfreq 0 .r cr
  2053. [ .then ]
  2054.    ELSE
  2055.    address  1 Props  =
  2056.    IF
  2057.    
  2058.       RNGRATE -> PropRange
  2059.       1 PInfos s@ pi_HorizPot 2/   PropRange *  15 >>  MINRATE +
  2060.                                               voice_io s! ndi_rate
  2061. [ exists? STDEBUG .if ]
  2062.          >newline ." Rate  = "
  2063.          voice_io s@ ndi_rate 0 .r cr
  2064. [ .then ]
  2065.    ELSE
  2066.    address  2 Props  =
  2067.    IF
  2068.    
  2069.       RNGPITCH -> PropRange
  2070.       2 PInfos s@ pi_HorizPot 2/   PropRange *  15 >>  MINPITCH +
  2071.                                               voice_io s! ndi_pitch
  2072. [ exists? STDEBUG .if ]
  2073.          >newline ." Pitch = "
  2074.          voice_io s@ ndi_pitch 0 .r cr
  2075. [ .then ]
  2076.    ELSE
  2077.    address  3 Props  =
  2078.    IF
  2079.    
  2080.       RNGVOL -> PropRange
  2081.       3 PInfos s@ pi_HorizPot 2/   PropRange *  15 >>  MINVOL +
  2082.                                               voice_io s! ndi_volume
  2083. [ exists? STDEBUG .if ]
  2084.          >newline ." Vol.  = "
  2085.          voice_io s@ ndi_volume 0 .r cr
  2086. [ .then ]
  2087.    ELSE
  2088. [ exists? STDEBUG .if ]
  2089.       >newline ." Unhandled gadget up received!" cr
  2090. [ .then ]
  2091.    THEN THEN THEN THEN THEN THEN THEN
  2092.    THEN THEN THEN THEN THEN THEN THEN
  2093. ;  ' |gadgetmessage| is gadgetmessage
  2094.  
  2095.  
  2096. \ /* This calculates variables used to draw the mouth
  2097. \  * and eyes, as well as redrawing the face.
  2098. \  * Proportionality makes it very wierd, but it's
  2099. \  * wierder if you don't use a GimmeZeroZero window
  2100. \  * and GZZWidth/GZZHeight.
  2101. \  */
  2102. : |DrawFace|   ( -- )
  2103.    FaceWindow s@ wd_GZZWidth 2/  -> XMouthCenter
  2104. \    /* set left edge of left eye */
  2105.    FaceWindow s@ wd_GZZWidth 2 >>  -> EyesLeft
  2106. \    /* multiplier for mouth width */
  2107.    FaceWindow s@ wd_GZZWidth
  2108.    
  2109.    6 >>  -> MouthWMult
  2110.  
  2111.    FaceWindow s@ wd_GZZHeight 2 >>
  2112.          FaceWindow s@ wd_GZZHeight 4 >> -   -> EyesTop
  2113.    
  2114.    EyesTop  FaceWindow s@ wd_GZZHeight 3 >>  + 1+  -> EyesBottom
  2115.    FaceWindow s@ wd_GZZHeight EyesBottom -  -> yaw
  2116.    yaw 2/ EyesBottom + -> YMouthCenter
  2117.    yaw 5 >> -> MouthHMult
  2118.  
  2119. \    /* Set pen to White */
  2120.    FaceWindow s@ wd_RPort  BLKP  SetAPen()
  2121.    FaceWindow s@ wd_RPort  0  0  FaceWindow s@ wd_GZZWidth
  2122.          FaceWindow s@ wd_GZZHeight   RectFill()
  2123.  
  2124. \    /* Set pen to Blue */
  2125.    FaceWindow s@ wd_RPort GRYP  SetAPen()
  2126.    
  2127.    FaceWindow s@ wd_RPort
  2128.     EyesLeft EyesTop
  2129.     EyesLeft  FaceWindow s@ wd_GZZWidth  3 >>  +
  2130.     EyesTop   FaceWindow s@ wd_GZZHeight 3 >>  +    RectFill()
  2131.     
  2132.    FaceWindow s@ wd_RPort
  2133.     FaceWindow s@ wd_GZZWidth 2/  FaceWindow s@ wd_GZZWidth 3 >>  +
  2134.     EyesTop
  2135.     FaceWindow s@ wd_GZZWidth 1 >>
  2136.           FaceWindow s@ wd_GZZWidth 3 >> +  \  /* two >> 3, not one >> 2 */
  2137.           FaceWindow s@ wd_GZZWidth 3 >> +  \  /* so eyes are same width */
  2138.     EyesTop  FaceWindow s@ wd_GZZHeight 3 >> +        RectFill()
  2139.  
  2140.    FaceWindow s@ wd_RPort  REDP   SetAPen()   \  /* Set pen to Red */
  2141.    
  2142.    FaceWindow s@ wd_RPort
  2143.     XMouthCenter  FaceWindow s@ wd_GZZWidth 3 >>   -
  2144.     YMouthCenter   Move()
  2145.     
  2146.    FaceWindow s@ wd_RPort
  2147.     XMouthCenter  FaceWindow s@ wd_GZZWidth 3 >>  +
  2148.     YMouthCenter  Draw()
  2149. ; ' |DrawFace| is DrawFace
  2150.  
  2151.  
  2152. \ /* Deallocate any memory, and close all of the
  2153. \  * windows/screens/devices/libraries in reverse order to
  2154. \  * make things work smoothly. And be sure to check
  2155. \  * that the open/allocation was successful before
  2156. \  * closing/deallocating.
  2157. \  */
  2158. : |MyCleanup|  ( -- )
  2159.    read_port s@ mp_SigBit -1 -
  2160.    IF
  2161.       read_port s@ mp_SigBit  FreeSignal()
  2162.    THEN
  2163.    talk_port s@ mp_SigBit -1 -
  2164.    IF
  2165.       talk_port s@ mp_SigBit  FreeSignal()
  2166.    THEN
  2167.    FaceWindow
  2168.    IF
  2169.       FaceWindow CloseWindow()  0 -> FaceWIndow
  2170.    THEN
  2171.    ControlWindow
  2172.    IF
  2173.       ControlWindow CloseWindow()  0 -> ControlWindow
  2174.    THEN
  2175. \    /* freeimages makes sure image allocation was successful */
  2176.    freeimages
  2177.    NarratorOpenError 0=
  2178.    IF
  2179.       voice_io CloseDevice()
  2180.    THEN
  2181.    -Translator
  2182.    -graphics
  2183.    -intuition
  2184. ; ' |MyCleanup| is MyCleanup
  2185.  
  2186.  
  2187. \ /* Allocate chip memory for gadget images, and set the
  2188. \  * pointers in the corresponding image structures to point
  2189. \  * to these images. This must be done because the program
  2190. \  * could be loaded into expansion memory (off the side of
  2191. \  * the box), which the custom chips cannot access.
  2192. \  * And images must be in chip ram (that's memory that the
  2193. \  * custom chips can access, the internal 512K).
  2194. \  */
  2195. : |InitImages|  { | result -- 0=fail }
  2196. \ {
  2197. \    /* the images were staticly initialized above main */
  2198. \    extern USHORT *FemaleIData_chip;
  2199. \    extern USHORT *MaleIData_chip;
  2200. \    extern USHORT *HumanIData_chip;
  2201. \    extern USHORT *RobotIData_chip;
  2202. \    extern USHORT *FaceIData_chip;
  2203. \    extern USHORT *StopIData_chip;
  2204. \    int i;
  2205.  
  2206.    0 -> result
  2207.    
  2208. \    /* Allocate them all, stop and return false on failure */
  2209.    FemaleIData[]SIZE MEMF_CHIP AllocMem() dup -> FemaleIData_chip 0= ?GOTO.ERROR
  2210.    MaleIData[]SIZE   MEMF_CHIP AllocMem() dup -> MaleIData_chip   0= ?GOTO.ERROR
  2211.    HumanIData[]SIZE  MEMF_CHIP AllocMem() dup -> HumanIData_chip  0= ?GOTO.ERROR
  2212.    RobotIData[]SIZE  MEMF_CHIP AllocMem() dup -> RobotIData_chip  0= ?GOTO.ERROR
  2213.    FaceIData[]SIZE   MEMF_CHIP AllocMem() dup -> FaceIData_chip   0= ?GOTO.ERROR
  2214.    StopIData[]SIZE   MEMF_CHIP AllocMem() dup -> StopIData_chip   0= ?GOTO.ERROR    
  2215.    true -> result
  2216.    
  2217.    FemaleIData[]  FemaleIData_chip  FemaleIData[]SIZE ( 20 )  move
  2218.    MaleIData[]    MaleIData_chip    MaleIData[]SIZE   ( 20 )  move
  2219.    HumanIData[]   HumanIData_chip   HumanIData[]SIZE  ( 60 )  move
  2220.    RobotIData[]   RobotIData_chip   RobotIData[]SIZE  ( 60 )  move
  2221.    FaceIData[]    FaceIData_chip    FaceIData[]SIZE   ( 30 )  move
  2222.    StopIData[]    StopIData_chip    StopIData[]SIZE   ( 30 )  move
  2223.  
  2224.    FemaleIData_chip FemaleImage s! ig_ImageData
  2225.    MaleIData_chip   MaleImage   s! ig_ImageData
  2226.    HumanIData_chip  HumanImage  s! ig_ImageData
  2227.    RobotIData_chip  RobotImage  s! ig_ImageData
  2228.    FaceIData_chip   FaceImage   s! ig_ImageData
  2229.    StopIData_chip   StopImage   s! ig_ImageData
  2230. error:
  2231.    result
  2232. ; ' |initimages| is initimages
  2233.  
  2234.  
  2235. \ /* Deallocate the memory that was used for images,
  2236. \  * See initimages for more details.
  2237. \  */
  2238. : |freeimages| ( -- )
  2239. \ {
  2240. \    /* the images were staticly initialized above main */
  2241. \    extern USHORT *FemaleIData_chip;
  2242. \    extern USHORT *MaleIData_chip;
  2243. \    extern USHORT *HumanIData_chip;
  2244. \    extern USHORT *RobotIData_chip;
  2245. \    extern USHORT *FaceIData_chip;
  2246. \    extern USHORT *StopIData_chip;
  2247.  
  2248. \    /* Deallocate only if the pointer is really there. */
  2249.    RobotIData_chip
  2250.    IF
  2251.       RobotIData_chip RobotIData[]SIZE   FreeMem()
  2252.       0 -> RobotIData_chip
  2253.    THEN
  2254.    HumanIData_chip
  2255.    IF
  2256.       HumanIData_chip HumanIData[]SIZE   FreeMem()
  2257.       0 -> HumanIData_chip
  2258.    THEN
  2259.    MaleIData_chip
  2260.    IF
  2261.       MaleIData_chip MaleIData[]SIZE   FreeMem()
  2262.       0 -> MaleIData_chip
  2263.    THEN
  2264.    RobotIData_chip
  2265.    IF
  2266.       FemaleIData_chip FemaleIData[]SIZE   FreeMem()
  2267.       0 -> FemaleIData_chip
  2268.    THEN
  2269.    RobotIData_chip
  2270.    IF
  2271.       FaceIData_chip FaceIData[]SIZE   FreeMem()
  2272.       0 -> FaceIData_chip
  2273.    THEN
  2274.    RobotIData_chip
  2275.    IF
  2276.       StopIData_chip StopIData[]SIZE   FreeMem()
  2277.       0 -> StopIData_chip
  2278.    THEN
  2279. ; ' |freeimages| is freeimages
  2280.